home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1994…tember: Reference Library / Dev.CD Sep 94.toast / Periodicals / develop / develop Issue 11 / develop 11 code / The NetWork Project / Examples (Sources) / ScreenSaver.p < prev    next >
Encoding:
Text File  |  1992-07-15  |  5.0 KB  |  161 lines  |  [TEXT/MPS ]
  1. { © Copyright 1990,1991 The NetWork Project, StatLab Heidelberg. 
  2.   © Copyright 1990,1991 Joachim Lindenberg, Karlsruhe. All rights reserved. }
  3.  
  4. program ScreenSaver;
  5.  
  6. uses     MemTypes, QuickDraw, OSIntf, ToolIntf, SysEqu, Traps;
  7.  
  8.     PROCEDURE InitToolBox;
  9.         VAR
  10.             i : integer;
  11.             p : GrafPtr;
  12.             m : MenuHandle;
  13.             
  14.     BEGIN
  15.         MaxApplZone;
  16.         FOR i := 1 TO 10 DO
  17.             MoreMasters;
  18.         InitGraf(@thePort);                {initialize QuickDraw}
  19.         InitFonts;                           {initialize Font Manager}
  20.         InitWindows;                       {initialize Window Manager}
  21.         InitMenus;                           {initialize Menu Manager}
  22.         TEInit;                            {initialize TextEdit}
  23.         InitDialogs(NIL);                   {initialize Dialog Manager}
  24.         InitCursor;                        {call QuickDraw to make cursor (pointer) an arrow}
  25.  
  26.         m := GetMenu (256);
  27.         AddResMenu (m, 'DRVR');
  28.         InsertMenu (m, 0);
  29.     {    m := GetMenu (257); InsertMenu (m, 0); }
  30.     END;
  31.  
  32. type RgnHPtr = ^RgnHandle; IntPtr = ^integer;
  33.      PtPtr = ^Point;
  34.  
  35. var    mousergn : RgnHandle; frontmost : boolean;
  36.     ev : EventRecord; 
  37.     mousepos : Point; w : WindowPtr; sysv : longint;
  38.     count, sleep : integer;
  39.     savedmbarheight : integer;
  40.     
  41. procedure OpenFullScreenWindow (var w : WindowPtr);
  42.  
  43. var savedgrayrgn, newgrayrgn : RgnHandle; 
  44.     pw : integer; box : Rect;
  45.     
  46. begin
  47.  
  48. { Warning: If you are going to modify this screensaver, be sure not to add
  49.   code between this line and the line Note: below. Otherwise the system
  50.   may crash, because the grayrgn points to garbage. If you feel you absolutely
  51.   must add code in this part of the program, then please change the process
  52.   type to pMaster, and back to pSlave below. }
  53.   
  54. { calculate union of screenbits and grayrgn => total space of all screens }
  55.  
  56.     savedgrayrgn := RgnHPtr (GrayRgn)^;
  57.     newgrayrgn := NewRgn; RectRgn (newgrayrgn, screenbits.bounds);
  58.     UnionRgn (savedgrayrgn, newgrayrgn, newgrayrgn);
  59.     RgnHPtr (GrayRgn)^ := newgrayrgn; box := newgrayrgn^^.RgnBBox;
  60.  
  61. { set up full screen transparent window }
  62.  
  63.     w := NewWindow (nil, box, '', false, 
  64.         plainDBox, WindowPtr (-1), false, 0);
  65.     
  66.     pw := IntPtr (PaintWhite)^; IntPtr (PaintWhite)^:= 0;
  67.     ShowWindow (w); SetPort (w);
  68.     IntPtr (PaintWhite)^:= pw;
  69.     
  70. { restore grayrgn }
  71.  
  72.     RgnHPtr (GrayRgn)^ := savedgrayrgn; 
  73.     {DisposeRgn (newgrayrgn);}
  74.     if IntPtr (MBarHeight)^ = 0 then w^.visrgn := newgrayrgn; 
  75.         { A/UX 2.0 & 7.0 resets visible on ShowWindow -- this is a bug 
  76.           forcing this with >= 6.0.5 is OK }
  77.     InvalRgn (newgrayrgn);
  78.  
  79. { Note: grayrgn restored }
  80.     IntPtr (MBarHeight)^ := savedmbarheight;
  81. end;
  82.  
  83. const _AUXDispatch = $ABF9;
  84.  
  85. function TrapAvail (trap : integer) : boolean;
  86. begin
  87.   TrapAvail := NGetTrapAddress (trap, TrapType (trap >= $A800))
  88.     <> NGetTrapAddress (_Unimplemented, ToolTrap)
  89. end;
  90.  
  91. procedure ErrorExit (err : integer);
  92. begin
  93.     if err <> noErr then if TrapAvail (_DebugStr) then DebugStr ('Screensaver detected error'); { ExitToShell; }
  94. end;
  95.  
  96. var sysenv : SysEnvRec;
  97.  
  98. begin
  99.     InitToolBox; 
  100.     w := nil; count := 5; sleep := 0;
  101.     frontmost := true;
  102.     
  103.     savedmbarheight := IntPtr (MBarHeight)^;
  104.     if SysEnvirons (1, sysenv) = noErr then;
  105.     if (sysenv.systemVersion >= $700) | TrapAvail (_AUXDispatch) then IntPtr (MBarHeight)^ := 0; 
  106.     
  107. {    we want to exit if either NetWork Processor tells us to exit, or if
  108.     we detect some user activity ourselves. In the latter case, Multifinder
  109.     will hand us an event which we ignore. The use of a mouse moved event
  110.     allows us to use a large sleep value. If we want to detect modifiers
  111.     in a timely manner, we would have to use a smaller value (modifiers
  112.     are detected by NetWork Processor, but not by Multifinder. }
  113.  
  114. { set mousergn to current mouse position }
  115.     
  116.     mousepos := PtPtr (Mouse)^;
  117.     { GetMouse (mousepos); LocalToGlobal (mousepos); }
  118.     mousergn := NewRgn; 
  119.     with mousepos do SetRectRgn (mousergn, h, v, h+1, v+1);
  120.     
  121.     repeat
  122.         ObscureCursor; { background InitCursors not shielded by Multifinder }
  123.          
  124.         if WaitNextEvent (EveryEvent, ev, sleep, mousergn) then 
  125.             case ev.what of
  126.                 updateEvt : begin
  127.                         BeginUpdate (w); 
  128.                         FillRgn (w^.visRgn, black);
  129.                         EndUpdate (w);
  130.                     end;
  131.                 diskEvt : if Point (ev.message).v <> noErr then
  132.                             if Eject (nil, Point (ev.message).h) <> noErr then;
  133.                         {    cannot handle bad disk, because this causes a modal dialog
  134.                             => NetWork Processor will kill us. Eject the disk instead. }
  135.                 app4Evt : if BAnd (ev.message, $ff000000) = $01000000 then begin
  136.                                 frontmost := odd (ev.message);
  137.                                 if frontmost & (w = nil) then begin
  138.                                     count := 5; sleep := 0;
  139.                                 end
  140.                                 else if frontmost | (w = nil) then ev.what := nullEvent
  141.                                 { else exit }
  142.                           end;
  143.  
  144.             {    otherwise DebugStr ('some other event'); }
  145.             end;
  146.             
  147.         { inclusion of app4Evt causes us to exit if another program is launched frontmost.
  148.           if screensaver does not exit, you won´t see anything. filter app4Evts if you
  149.           want a different behaviour. Note that app4Evt can be a mousemoved evt too. }
  150.           
  151.         if frontmost & (w = nil) then
  152.             if count > 0 then count := count - 1
  153.             else if count = 0 then OpenFullScreenWindow (w)
  154.             else 
  155.         else sleep := 60;
  156.          
  157.     until ev.what in [keydown, mousedown, diskEvt, app4Evt];
  158.     
  159.     if w <> nil then DisposeWindow (w); { forces update of all windows }
  160. end.
  161.